perm filename SCMSS.F4[NEW,LCS]20 blob sn#418042 filedate 1979-02-13 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C******  SCMSS *********** 12/1/75
C00024 00003	2114	FORMAT(72A1)
C00030 ENDMK
C⊗;
C******  SCMSS *********** 12/1/75
	SUBROUTINE SCMSS
	COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1) 
	1 /MKX/KSLA,ISM,LESS,IGT,NNO(5),MINUS
	COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,NOSET,
	1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB /JCHAR/IXX,ISEMI,IBLA
	1 /A2Z/LAA,LBB,A1(4),LGG,A2(6),LNN,LOH,A3(3),LSS,LTT,A4(4),LYY
	1 /NUM/NUM(9),N9
       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
	DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
C  /SCX/ ALSO IN WORDS, NEWR
	COMMON/SCX/JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
	1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
	1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /IDEV/IDEV
	1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
	1,NFLG,JXX,ISEMX,JG,VX(50),IAMP,K,KN,M,MODE,IBLX
      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
     1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
	1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
	1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
	1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
	1JALPHA(3))
C--THESE ARE IN 'RESTS' NOW.	DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
	JDEV=IDEV
1177	RB=0
	IF(JA.EQ.140)GO TO 77
	IF(JA.NE.144)GO TO 11
77	MODE=1
	IBEAM=-1
	IZ=0
	IREAD=0
	POS2=0
	POS1=0
CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
	IF(JA.NE.144)GO TO 91
	REREAD 80052,L,L,L,STAFF,RMODE2
C GET THE FILE NAME FOR 'READ NAME'
	CALL LO2UP(L)
	IF(LOOK(L)+LOOKD(L))GO TO 101 
	CALL TYPSTR('FILE NOT FOUND - ')
	CALL TYPWRD(L)
	CALL TYPCRLF
	GO TO 690
101 	IREAD=-1
C IREAD=-1 =SOS FILE.  =-2 =NO LINE NUMBERS.
	REWIND 22
	CALL IFILE(22,L)
291	READ(22,21141,END=68),L,INP
	IF(L.NE.0)GO TO 491
C  JUMP IF LINE NUMBERS
	IREAD=-2
C  THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
	IF(INP1.EQ.LOH)GO TO 391
	REREAD 2114,INP

491	RB=0
	IF(INP1.EQ.ISTAR)GO TO 191 
	CALL TYPSTR('STAFF NUM=')
	ACCEPT 80052,STAFF
CC	REREAD 4177,RA,RB
CC	CALL LO2UP(RA)
	CALL A2READ(RA,RB)
	IF(RA.NE.'SP')GO TO 91
C NOW SPACER CAN BE SET AT THIS POINT
	SET4=RB
	GO TO 111
191	REREAD 2310,L,SET4,STAFF,POS1,POS2,PSFB
C READS SPACING STAFF NUM, THIS STAFF NUM, AND POSITIONS.
C  FIRST CHAR. MUST BE * .    !!! ASSUMES NO LINE NUMBERS NOW!!!
	IF(POS2.EQ.0)POS2=200
	READ(22,2114)INP
	CALL LULOOP
C LULOOP CHANGES ALL LOWER CASE TO UPPER IN 'INP' ARRAY.
	RB=-1
91	CALL TYPSTR('SPACING STAFF =')
	CALL TYPFLT(SET4)
	CALL TYPCRLF
	GO TO 111 

391 	READ(22,2114,END=68)INP
C GET RID OF DIRECTORY
	IF(INP3.NE.ISEMI)GO TO 391
 	READ(22,2114,END=68)INP
	GO TO 291 

11	IF(IREAD)GO TO 2304
	RB=0
	GO TO 111
467	IDEV=5
	GO TO 4333
444	SET4=RA
111	CALL SETUP
	IF(STUP.GE.0)GO TO 8
C SKIPS IF USING SETUP ON SOME STAFF
	IF(POS2.NE.0)GO TO 4334
C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
4333  	IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC)  ')
	READ(IDEV,F78F,END=467)POS1,POS2,PSFB
C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
CC	REREAD 4177,K,RA  
CC	CALL LO2UP(K)
	CALL A2READ(K,RA)
	IF(K.EQ.'SP')GO TO 444
C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
	IF(K.EQ.IAT)GO TO 467
CATCH '@' WHEN POS1 AND P2 ARE EXPECTED.
	IF(K.EQ.LESS)GO TO 467
	IF(K.NE.IGT)GO TO 567
	IDEV=1
	GO TO 4333
567	IF(POS2.EQ.0)POS2=200.
	IF(POS1.GE.POS2)GO TO 4333
C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
4334	STUP=STUP-PSFB
	IF(JA.EQ.144)GO TO 2177

8	IF(JA.EQ.144)GO TO 2311
	IF(JA)GO TO 691
	CALL TYPCRLF
	IF(RB.GT.0)GO TO 891
	IF(IREAD)GO TO 2304
367	GO TO (1,2,3,4,5,677)MODE
CCC367	GO TO (1,2,3,4,5,69)MODE
	GO TO 2177
2304	IF(IREAD.EQ.-1)REREAD 21141,L,INP
	IF(IREAD.EQ.-2)REREAD 2114,INP
	CALL LULOOP
2303	RB=0
	IF(INP1.EQ.ISTAR)GO TO 991
CCC	RB=1
CCC	GO TO 111
	POS2=0
	JA=144
	GO TO 491

991	REREAD 2310,L,SET4,STAFF,POS1,POS2,PSFB
C READS SPACING STAFF NUM, THIS STAFF NUM, AND POSITIONS.
C  FIRST CHAR. MUST BE * .    !!! ASSUMES NO LINE NUMBERS NOW!!!
	IF(POS2.EQ.0)POS2=200
	JA=-1 
	GO TO 111
691	READ(22,2114)INP
	CALL LULOOP
	JA=144
	RB=-1
2311	IF(IREAD)GO TO 2177
891	CALL TYPSTR('STAFF NUM=')
	IF(RB)GO TO 231
	IF(STFNUM(STAFF))GO TO 2305
231	CALL TYPFLT(STAFF)
	IF(RB.GE.0)GO TO 2177
	CALL TYPCRLF
	IF(JA.EQ.144)GO TO 2177
	GO TO 91
CV	CALL TYPSTR('SPACING STAFF =')
CV	CALL TYPFLT(SET4)
CV	CALL TYPCRLF
C FILE CAN SET STAFF # AND SPACING STAFF # (STn/SPn/)
CC	IF(JA.EQ.144)GO TO 2177
CV	GO TO 111 
167	IDEV=5
	GO TO 2311
2305	READ(IDEV,80052,END=167)STAFF
  	IF(STAFF.NE.444)GO TO 2177
CC	REREAD 4177,RA,RB
CC	CALL LO2UP(RA)
	CALL A2READ(RA,RB)
	IF(RA.EQ.LESS)GO TO 167
	IF(RA.NE.IGT)GO TO 667
	IDEV=1
	GO TO 891
667	IF(RA.NE.'SP')GO TO 2177
C NOW SPACER CAN BE SET AT THIS POINT
	SET4=RB
	GO TO 2303
2310	FORMAT(A1,5F)
2177	IF(IREAD)CALL TYPOUT
	IF(STAFF.GE.99)GO TO 690
C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
	REND=0
	IF(IREAD)GO TO 80041
2301	IF(IREAD.EQ.-2)GO TO 2307
	READ(22,21141,END=68),L,INP
	IF(L.NE.0)GO TO 2300
C  JUMP IF LINE NUMBERS
	IF(INP1.EQ.LOH)GO TO 2307
	IREAD=-2
C  THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
	REREAD 2114,INP
	GO TO 2300
2307	READ(22,2114,END=68)INP
	IF(IREAD.EQ.-2)GO TO 2300
	IF(INP3.NE.ISEMI)GO TO 2307
	IREAD=-2
	READ(22,2114)INP
	GO TO 2307
2300	CALL LULOOP
	IF(JA.NE.144)GO TO 2308
	IF(MODE.EQ.1)GO TO 2303
2308	IF(MODE.EQ.6)GO TO 1111
	IF(INP1.EQ.IBLA)GO TO 8006
	IF(INP1.EQ.ISEMI)GO TO 8006
C  'ET' FILES MUST HAVE ';' AS 1ST CHAR.  BLANK LINES ARE IGNORED!!
	CALL TYPOUT
CC	IF(IDEV.EQ.5)CALL TYPOUT
	GO TO 6177
1111	MODE=1
	REND=2
	IZ=0
C   ABOVE ALLOWS MORE STAVES TO BE READ
2111	IDEV=JDEV
	RETURN
CC168	IF(NOSET.EQ.0)RETURN

80052	FORMAT(F,A4,A5,2F)
267	IDEV=5
	IF(MODE.EQ.3)CALL NOTNUM
	GO TO 2111
CXX	GO TO 367
4	IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS?  ')
330	READ(IDEV,2114,END=677)INP
CC330	READ(IDEV,2114,END=267)INP
	CALL LULOOP
	IF(INP1.EQ.LGG)GO TO 677
CCC	IF(INP1.EQ.'G')GO TO 69
C  TYPE 'GO' TO PASS LATER ITEMS
	IF(INP1.EQ.N9.AND.INP2.EQ.INP1)GO TO 99
	IF(INP1.EQ.LBB)GO TO 99
	IF(INP1.EQ.LYY)GO TO 1
C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
	IF(INP1.EQ.LNN)GO TO 2000
	IF(INP1.EQ.ISEMI)GO TO 2000
	IF(INP1.EQ.LESS)GO TO 267
	IF(INP1.NE.IGT)GO TO 767
	IDEV=1
	GO TO(1,2,3,4,5)MODE
767	IF(INP1.NE.IBLA)GO TO 5177
2000	MODE=MODE+1
	IF(IDEV.EQ.5)WRITE(21,2114)INP4
	GO TO 11
CCC69	IF(IDEV.EQ.1)GO TO 690
CCC	END FILE 21
CCC	CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
CCC	CALL TYPCRLF
690	REND=1
	GO TO 2111
CC	GO TO 168
3	IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS?  ')
	GO TO 330
5	IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS?  ')
	GO TO 330

8006	MODE=MODE+1
	IF(MODE.NE.2)GO TO 177
CCC	IF(RMODE2.EQ.2)GO TO 80041
C   FOR NEW INPUT FORMAT -- TYPE 140 2 OR 144 -2 ETC.
177	IF(IREAD)GO TO 2301
	IF(MODE.GT.5)GO TO 677
	IF(IDEV.EQ.1)GO TO 367 
C RETURN ONLY IF IN TTY MODE. (NOT READING A FILE)
	GO TO 2111
677	IF(IDEV.EQ.1)GO TO 68
	END FILE 21
	CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
	CALL TYPCRLF
68	REND=-1
	GO TO 2111
CC	GO TO 168

99	IF(INP3.EQ.N9)GO TO 999
C ELSE GET ANOTHER CHANCE TO SAY 'NO'.  99=BACKUP,  999=ESCAPE
	MODE=MODE-1
	IF(MODE.EQ.0)GO TO 999
	IS=ISV(MODE)
	GO TO 11
C  INSERT BACKUP ROUTINE
999	REND=99
	GO TO 2111
C FIX BACKUPS********

8015	RA=0
	DO 15 J=1,I-1
15	RA=RA+4./V(J)
	K=IRHY-I+1
	CALL TYPSTR('TOTAL RHY=')
	CALL TYPFLT(RA)
	CALL TYPSTR(' QTRS. ')
	CALL TYPINT(K)
	CALL TYPSTR(' MORE RHYTHMS NEEDED')
	CALL TYPCRLF
	IDEV=5
C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
	IF(IREAD)IREAD=-IREAD
C  ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
2	IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
	CALL TYPINT(IRHY)
	CALL TYPSTR(' RHYTHMS')
	CALL TYPCRLF

1	ISV(MODE)=IS
	CALL TYPE
	IF(INP1.NE.IAT)GO TO 1001
C '@' STARTS MODE2 INPUT
	IF(INP2.NE.IBLA)GO TO 1001
C BUT NOT IF IT'S REALLY A MOTIVE CALL
	CALL PRESCN
	CALL IFILE(22,'MODE2')
	READ(22,2114)INP
	CALL LULOOP
	IREAD=-2
	IDEV=-1
	Z=STUP
	CALL SETUP
C MUST RECALL SETUP BECAUSE SOME ARRAYS WERE USED IN PRESCN.(??)
	STUP=Z
	GO TO 6177
CC1001	REREAD 4177,RA,RB
CC	CALL LO2UP(RA)
1001	CALL LULOOP
	CALL A2READ(RA,RB)
	IF(RA.NE.'SP')GO TO 5177
	SET4=RB
C CAN SET SPACER HERE
	GO TO 1177
5177	IF(INP1.EQ.IBLA) GO TO 1
	IF(INP1.NE.N9)GO TO 80041
	IF(INP2.EQ.N9)GO TO 99
C  TYPE '99' TO BACK-UP
80041	IF(IREAD.LT.0)GO TO 6177
	IF(IDEV.EQ.5)WRITE(21,2114)INP
6177	CALL LNEND
	GO TO(333,433,533)MODE-2
C GO TO MARKZ, BEAMS, SLURZ
	RETRO=-1.
	I=1
	PARENS=0
	MOT=0
      JZ=1  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      KL=0  
      RA=0  
	IF(MODE.EQ.2)GO TO 2408
C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
	IF(INP1.NE.LSS)GO TO 2408
	IF(INP2.NE.LTT)GO TO 2408
	K=1
	L=3
	IF(INP3.NE.MINUS)GO TO 1277
	K=-1
	L=4
1277	STAFF=NALF(INP(L))*K
2277	MLX=L+1
	IF(INP(MLX).NE.KSLA)GO TO 2277
	MLX=MLX+1
	GO TO 3277
2408	MLX=1
3277	L=-1
CCCC	IF(RMODE2.EQ.2)CALL PRESCN
C   GO SORT OUT THE NEW FORMAT
	DO 2999 K=1,72
	N=INP(K)
	IF(N.EQ.IBLA)GO TO 2999
	L=0 
	IF(N.EQ.ISTAR)GO TO 277
	IF(N.NE.ISEMI)GO TO 2999
C  READS 72 CHARS. INCLUDING ;.
277	INP(K+1)=ISEMI
	GO TO 1773
C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999	CONTINUE
	IF(IREAD)GO TO 8015
	CALL TYPSTR('****** TRY AGAIN ***** ')
	CALL TYPCRLF
	GO TO 1

1299	IF(JZ.NE.0)GO TO 1773
7773	IF(MODE.NE.2)GO TO 377
CCC	IF(RMODE2.EQ.2)GO TO 77732
C  ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
377	IF(IREAD.EQ.0)GO TO 77731
C   BYPASS IF NOT USING EDIT FILE
	IF(IREAD.EQ.-1)READ(22,21141),L,INP
	IF(IREAD.EQ.-2)READ(22,2114)INP
C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
	CALL TYPOUT
	CALL LULOOP
CC	IF(IDEV.EQ.5)CALL TYPOUT
	GO TO 77732
77731	CALL TYPE

	IF(INP1.EQ.IBLA)GO TO 7773
	IF(IDEV.EQ.5)WRITE(21,2114)INP
	CALL LULOOP
77732	CALL LNEND
	JM=-1
	JZ=0
	GO TO 2408
C   'LISTS' MUST END WITH ; 
1773	JZ=0
	DBST=1.
	IF(XDBST)DBST=-DBST
	XDBST=0
17731	ML=MLX
	IF(PARENS.LE.0.)GO TO 975
C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362	PARENS=0
	MOT=I-LMOT
	IF(LCNT+MOT.LT.198)GO TO 33621
	CALL TYPSTR(' NO ROOM FOR MOTIVE ')
	CALL TYPCHR(JMOT,1)
	CALL TYPCRLF
	GO TO 1
33621	JLIST(LCNT+1)=MOT
	LCNT=LCNT+2
	DO 2140 JG=0,MOT-1
2140	RLIST(LCNT+JG)=V(LMOT+JG)
	LCNT=LCNT+MOT
	IF(IAMP)GO TO 3013
C  FOR CLOSE PARENS ON LAST ITEM
C   STORE MOTIVE IN RLIST ARRAY

975	DO 236 JDD=ML,72
	JD=JDD
	N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
	IF(N.EQ.ILP)GO TO 477
	IF(N.EQ.IRP)GO TO 477
	IF(N.NE.ICOL)GO TO 2361
477	INP(JD)=IBLA
	IF(N.NE.ICOL)GO TO 1113
	XDBST=-1.
	GO TO 5362
C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
1113	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.IRP)GO TO 3361
C  ONLY ONE () AS YET,  NO NESTING
1140	JMOT=INP(L)
C   MOTIVE NAME
	DO 11401 JC=1,LCNT-1
	IF(JMOT.NE.JLIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
	CALL TYPSTR(' MOTIVIC (')
	CALL TYPCHR(JMOT,1)
	CALL TYPSTR(') USED TWICE')
	CALL TYPCRLF
	JLIST(JC)=0
C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
11401	CONTINUE
	JLIST(LCNT)=JMOT
	PARENS=-1.
C   A PARENTH IS OPEN
	INP(L)=IBLA
	LMOT=I
C   LMOT IS CURRENT POINT IN V ARRAY
	GO TO 236
3361	IF(PARENS.NE.0)GO TO 33612
	CALL TYPSTR('PARENTH ERROR - GOING ON')
	CALL TYPCRLF
33611	INP(JD)=IBLA
	GO TO 236
33612	PARENS=1.
C   SETS PARENS CLOSED FLAG
	GO TO 33611
C   NO INVERSIONS POSSIBLE NOW
2361	IF(N.NE.IAT)GO TO 5361
	DO 113 L=1,72
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.NEG)GO TO 7113
	RETRO=0
	INP(K)=IBLA
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 L=1,LCNT
	IF(JG.NE.JLIST(L))GO TO 6361
	VX1=0
	DO 40 M=JD+2,72
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	IF(JG.EQ.ISTAR)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JM
	JM=-1
	INP(K)=IBLA
	JN=0
C   MUST BE ZERO IN SCANR
	CALL SCANR
	JM=JC
140	JC=1
	KN=L+2
	M=KN+JLIST(L+1)
	IF(RETRO)GO TO 940
	KN=M-1
	M=L+1
	JC=-1
	RETRO=-1.

940	Z=RLIST(KN)
	IF(VX1.EQ.0)GO TO 540
C  " @Q N "  WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(MODE.EQ.1)GO TO 440
C  MODE 1 IS NOTES, 2 IS RHY.
	V(I)=Z*VX1
	GO TO 7361
440	IF(ABS(Z).GE.2000.)GO TO 540
C  SKIPS NON-NOTES
	RB=VX1
	IF(Z)RB=-RB
C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
C  NEG NUMS ARE CHORD NOTES.
	V(I)=Z+RB
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	RB=V(I-1)
	DO 8361 L=JD,72
	JG=INP(L)
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.ISEMI)GO TO 93611
8361	IF(JG.EQ.ISTAR)IAMP=-1
9361	MLX=L
	IF(IAMP.EQ.0)GO TO 17731
	JZ=-1
93611	IF(IAMP)GO TO 3013
	GO TO 7773
6361	CONTINUE
	CALL TYPSTR(' MOTIVIC (')
	CALL TYPCHR(JG,1)
	CALL TYPSTR(') NOT FOUND')
	CALL TYPCRLF
	GO TO 11401
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.NE.KSLA)GO TO 636
5362	MLX=JD+1
	JZ=-1
	INP(JD)=ISEMI
436	IF(INP(MLX).NE.IBLA)GO TO 103
	MLX=MLX+1
	GO TO 436
636	IF(N.EQ.ISEMI)GO TO 103
936	IF(N.NE.IDOT)GO TO 736
	L=INP(JD+1)
	KL=NALF(L)
	IF(L.LE.0)GO TO 577
	IF(KL.LT.0)GO TO 577
	IF(KL.LE.9)GO TO 236
C   JUMP IF IT'S A NUMBER
577	IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
736	IF(N.NE.ISTAR)GO TO 236
	IAMP=-1
	INP(JD)=ISEMI
	GO TO 103
236	CONTINUE
2114	FORMAT(72A1)
21141	FORMAT(I,72A1)

5016	IF(IAMP.GE.0)GO TO 1299
	IF(PARENS.NE.0)GO TO 3362
C  PARENS ARE STILL OPEN?
	GO TO 3013
103	K=INP(ML)

C   LAST SECTION
	IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 103
1899	JN=0
C   MUST BE ZERO IN SCANR
	VX4=0
	NOAC=0
	CALL SCANR
      IF(VX1.EQ.-99.)GO TO 4022
C NO MORE COMPOSITES IN RHYTH.  DOTS ARE INDICATED BY 100S.
C RHYTH. NUMB IS KEPT HERE.  DOTTED QUARTER IS NOW 104. DBL..=204
17	IF(MODE.NE.2)GO TO 117
	IF(JJ.EQ.1)GO TO 117
	IF(VX2.EQ.0)GO TO 117
C VX2=0 IF "X" IS USED.  (8X3  FORMS VX1=8, VX2=0, VX3=3)
	RB=0
	DO 2117 K=1,JJ
2117	RB=RB+4./VX(K)
	VX1=4./RB
C FOR COMPOSITE RHYTHMS. (USEFUL FOR 'WHOLE' RESTS IN 5/4, ETC.)
	JJ=1
117	V(I)=VX1
	IF(VX4.EQ.0)GO TO 115
	IF(MODE.NE.1)GO TO 115
	I=I+1
C  FOR + OR -.  AUTO OCTAVES, ETC.
	V(I)=-VX1-VX4
115	IF(JJ.LE.1)GO TO 114
	IF(MODE.NE.1)GO TO 171
	IF(VX2.EQ.0)GO TO 171
C  JUMP IF RHY OR 'X 4' ETC.
	V(I)=18000.0+VX1*10.0+VX2/10.0
C  PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n  xy=top, zn=bottom)
114	I=I+1
	GO TO 5016
171	JC=1
	JD=VX(JJ)-1
	I=I+1
	GO TO 5005
1014	JD=1
	JC=1
C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
	GO TO 5005
4022      JC=VX2+.3
      JD=VX3-.5
	IF(MODE.EQ.1)NOAC=-1
C ACCIS WILL NOT!! REPEAT UNLESS 100 IS ADDED TO 1ST NUM.******6/78
	IF(JJ.EQ.2)JD=1
C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
	IF(JC.LT.100)GO TO 5005
C ADD 100 TO NUM OF NOTES TO REPEAT ACCIS WITH 'REP N1, N2'.
	JC=JC-100
	NOAC=0
5005	N=0
	DO 3005 K=I-1,1,-1
	IF(V(K))GO TO 3005
	IF(V(K).LT.3000)N=N+1
C  COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
3005	IF(N.EQ.JC)GO TO 4005
4005	IF(JC.GT.1)GO TO 7005
	IF(MODE.EQ.1)NOAC=-1
C 5/76 *******   AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
C  ACCIS ARE DROPPED WITH / OR Xn REPEAT.  (BUT NOT WITH 'REP' OR '/X n,n/')
7005	JC=I-K
C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
	DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
	KN=L-JC
	RB=V(KN)
	IF(NOAC.GE.0)GO TO 2005
	IF(ABS(RB).GE.2000)GO TO 2005
C  SKIP OVER IF NOT A NOTE
	RB=AMOD(RB,100.0)+1000.0
	IF(V(KN))RB=RB-2000.0
C  DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
2005	V(L)=RB
1005      I=I+JC  
      GO TO 5016  

3013	IF(MODE.NE.2)GO TO 771
	IF(I-1.NE.IRHY)GO TO 8015
C  WRONG NUMBER OF ITEMS
771	V(I)=-99.
	IF(MODE.NE.1)GO TO 132
C  FOR ADDED NOTES ON SPACING STAFF
	CALL NOTES
C SAVES TOTAL OF ITEMS FOR LABEL 168
67	CALL NEWR
	IX=IS
C SAVE PTR TO RN ARRAY FOR TREM. OVER BEAM LATER. (IN 'BEAMS.F4')
	GO TO 8006
132	IF(IREAD.GT.0)IREAD=-IREAD
	CALL RHYTH
C  =50 IS RHYTHM FOR TEXT
	GO TO 67
134	IF(IDEV.EQ.5)WRITE(21,2114)INP
C  WRITES TYPED IN REPLY TO 'ADD BEAMS?'
C   ACCENTS ARE IN MARKZ SUBROUTINE
	GO TO 8006
533	CALL SLURZ
	GO TO 8006
433	CALL BEAMS
C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
	IBEAM=0
	GO TO 8006
333	CALL MARKZ
135	K=IS
	CALL NEWR
	IS=K
C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
	GO TO 8006
	END

	SUBROUTINE A2READ(A,B)
	REREAD 1,A,B
	CALL LO2UP(A)
1	FORMAT(A2,F)
	END